home *** CD-ROM | disk | FTP | other *** search
/ Wonky Flux Batch 2019 02 / Wonky_Flux_Batch_2019-02.zip / Wonky Flux Batch 2019-02 / 057 - Algebra Workshop.dsk / XY.EQUATIONS.bas < prev   
BASIC Source File  |  2019-02-17  |  8KB  |  245 lines
  1. 100  REM     XY EQUATIONS
  2. 110  GOTO 2200
  3. 120  HOME 
  4. 130  PRINT "FRACTIONS SUBROUTINES"
  5. 140  PRINT : PRINT "STARTING LOCATIONS:"
  6. 150  PRINT : PRINT "GCD : A,B<> 0 IN, GCD OUT:230"
  7. 160  PRINT : PRINT "REDUCE:NUM,DEN IN, NNUM,NDEN OUT:350"
  8. 170  PRINT : PRINT "MULTIPLY:N1/D1, N2/D2 IN, N3/D3 OUT:480"
  9. 180  PRINT : PRINT "ORDER: N1/D1,N2/D2 IN,"
  10. 190  PRINT : PRINT "         MARK = -1,0,1 OUT:590"
  11. 200  PRINT : PRINT "SUM: N1/D1, N2/D2 IN, N3/D3 OUT : 720"
  12. 210  PRINT : PRINT "GETTER:NUM,DEN OUT:830"
  13. 220  PRINT : PRINT "LAST LINE: 1070": END 
  14. 230  REM  GCD SUBROUTINE:A,B IN,GCD OUT
  15. 240  REM  SUBROUTINE ASSUMES B<>0
  16. 250 Q =  INT(A/B): REM  DIVIDE A BY B
  17. 260 R = A -Q *B: REM  REMAINDER
  18. 270  IF R = 0  THEN 310: REM   ALGORITHM FINISHED,GCD IS B
  19. 280  REM  IF R <> 0 MUST DO ANOTHER DIVISION
  20. 290  REM  NOW SET UP FOR NEXT DIVISION
  21. 300 A = B:B = R: GOTO 250
  22. 310 GCD = B
  23. 320  RETURN 
  24. 330  REM  SUBROUTINE FINISHED
  25. 340  REM 
  26. 350  REM   SUBROUTINE TO REDUCE FRACTION
  27. 360  REM  USING GCD SUBROUTINE
  28. 370  REM    NUM, DEN IN, NNUM,NDEN OUT
  29. 380  REM  IF NUM = 0, SKIP GCD SUBRTN
  30. 390  IF NUM = 0  THEN NNUM = 0:NDEN = 1: RETURN 
  31. 400 A = NUM:B = DEN
  32. 410  GOSUB 250: REM  GCD SUBROUTINE
  33. 420  REM  SUBROUTINE RETURNS GCD
  34. 430  REM   NOW DIVIDE OUT BY GCD:
  35. 440 NNUM = NUM/GCD:NDEN = DEN/GCD
  36. 450  REM  REDUCED FORM IS NNUM/NDEN
  37. 460  RETURN 
  38. 470  REM 
  39. 480  REM  SUBROUTINE TO MULTIPLY FRACS
  40. 490  REM  N1/D1 AND N2/D2 IN, N3/D3 OUT
  41. 500  REM 
  42. 510  REM  COMPUTE UNREDUCED PRODUCT NUM/DEN
  43. 520 NUM = N1 *N2
  44. 530 DEN = D1 *D2
  45. 540  GOSUB 350: REM   REDUCE TO NNUM/NDEN
  46. 550  REM  SET UP FOR RETURN
  47. 560 N3 = NNUM:D3 = NDEN
  48. 570  RETURN 
  49. 580  REM 
  50. 590  REM  SUBROUTINE TO ORDER FRACTIONS
  51. 600  REM  N1/D1 AND N2/D2 IN
  52. 610  REM  RETURNS:
  53. 620  REM              MARK=-1 IF N1/D1<N2/D2
  54. 630  REM              MARK = 0 IF N1/D1=N2/D2
  55. 640  REM            MARK=1 IF N1/D1>N2/D2
  56. 650  REM  CROSS MULTIPLY:
  57. 660 A = N1 *D2:B = N2 *D1
  58. 670  IF A <B  THEN MARK =  -1
  59. 680  IF A = B  THEN MARK = 0
  60. 690  IF A >B  THEN MARK = 1
  61. 700  RETURN 
  62. 710  REM 
  63. 720  REM  SUBROUTINE TO ADD FRACTIONS
  64. 730  REM  N1/D1 AND N2/D2 IN,
  65. 740  REM  SUM N3/D3 OUT
  66. 750  REM  FORM UNREDUCED SUM:
  67. 760 NUM = N1 *D2 +N2 *D1
  68. 770 DEN = D1 *D2
  69. 780  IF NUM = 0  THEN N3 = 0:D3 = 1: GOTO 810: REM  SKIP REDUCE
  70. 790  GOSUB 350: REM  REDUCE TO NNUM/NDEN
  71. 800 N3 = NNUM:D3 = NDEN
  72. 810  RETURN 
  73. 820  REM 
  74. 830  REM  SUBRTN TO READ FRAC FROM KYBD
  75. 840  REM  SUBRTN EXPECTS STRING NUM/DEN
  76. 850  REM         AND EXTRACTS NUM AND DEN
  77. 860  REM  BEFORE ENTERING SBRTN, SET
  78. 870  REM   VV$= SOME CONNECTING WORD
  79. 880  REM :PRINT : PRINT "PLEASE TYPE ";VV$;"FRACTION"
  80. 890  INPUT A$
  81. 900  REM  SEARCH FOR "/" IN A$:
  82. 910  FOR K = 1 TO  LEN(A$)
  83. 920  REM  LOOK AT K TH CHARACTER OF A$
  84. 930 CHAR$ =  MID$ (A$,K,1)
  85. 940  IF CHAR$ = "/"  THEN 1010: REM   FOUND "/"
  86. 950  NEXT : REM  KEEP LOOKING FOR "/"
  87. 960  REM  HERE, A$ HAS NO "/";ASSUME A$ IS INTEGER
  88. 970 NUM =  VAL(A$): REM  NUMERICAL VAL OF A$
  89. 980 DEN = 1
  90. 990  RETURN 
  91. 1000  REM  HERE, HAVE FOUND "/" AS K-TH CHAR OF A$
  92. 1010 NUM$ =  LEFT$(A$,K -1)
  93. 1020 DEN$ =  RIGHT$(A$, LEN(A$) -K)
  94. 1030 NUM =  VAL(NUM$)
  95. 1040 DEN =  VAL(DEN$)
  96. 1050  IF DEN = 0  THEN  PRINT : PRINT "DENOMINATOR NOT ALLOWED TO BE ZERO.": GOTO 880
  97. 1060  RETURN 
  98. 1070  REM 
  99. 1080  REM  SUBROUTINE TO GET EQUATIONS
  100. 1090  REM           
  101. 1100  HOME 
  102. 1110 VARS = 2
  103. 1120  PRINT : PRINT "HOW MANY EQUATIONS";: INPUT EQNS
  104. 1130  DIM N(EQNS,VARS +1),D(EQNS,VARS +1)
  105. 1140  FOR ROW = 1 TO EQNS
  106. 1150  HOME 
  107. 1160  REM  GET EQUATION "ROW":
  108. 1170  REM 
  109. 1180  REM 
  110. 1190  PRINT "TYPE IN A,B,C FOR EQUATION ";ROW
  111. 1200  PRINT 
  112. 1210  PRINT "AX + BY = C"
  113. 1220  PRINT : PRINT "A = ";: GOSUB 830: REM   FRAC GETTER
  114. 1230 N(ROW,1) = NUM:D(ROW,1) = DEN
  115. 1240  PRINT "B = ";: GOSUB 830: REM  FRAC GETTER
  116. 1250 N(ROW,2) = NUM:D(ROW,2) = DEN
  117. 1260  PRINT "C = ";: GOSUB 830: REM  FRAC GETTER
  118. 1270 N(ROW,3) = NUM:D(ROW,3) = DEN
  119. 1280  REM 
  120. 1290  REM 
  121. 1300  REM 
  122. 1310  PRINT : PRINT "CHECK THE EQUATION": PRINT 
  123. 1320  GOSUB 1410
  124. 1330  PRINT : PRINT "IS THIS CORRECT (Y OR N)";
  125. 1340  REM 
  126. 1350  INPUT ANS$: IF ANS$ = "N"  THEN  HOME : GOTO 1180
  127. 1360  IF ANS$ < >"Y"  THEN 1350
  128. 1370  NEXT ROW
  129. 1380  REM  PRINT EQUATIONS:
  130. 1390  GOSUB 2450
  131. 1400  RETURN 
  132. 1410  REM 
  133. 1420  REM    SUB TO PRINT EQUATION "ROW"
  134. 1430  REM 
  135. 1440 FLAG = 0: REM  SET = 1 WHEN FIRST NON-ZERO COEF IS FOUND
  136. 1450  PRINT ROW;")  ";
  137. 1460  FOR COL = 1 TO VARS
  138. 1470  REM  IF COEF = 0, DON'T PRINT
  139. 1480  IF N(ROW,COL) = 0  THEN  PRINT  SPC( 4): GOTO 1650: REM   NEXT COL
  140. 1490  REM  HERE, HAVE NON-ZERO COEF
  141. 1500  REM  IF FLAG = 1, IT'S NOT THE FIRST NON-ZERO COEF
  142. 1510  REM  PRINT "+" ONLY FOR POS COEFS
  143. 1520  REM            AFTER THE FIRST
  144. 1530  IF FLAG = 1  AND N(ROW,COL) >0  THEN  PRINT "+";
  145. 1540 FLAG = 1
  146. 1550  REM  DON'T PRINT "1" DENOMS
  147. 1560  REM  DON'T PRINT "1/1" COEFS
  148. 1570  IF D(ROW,COL) = 1  THEN  IF N(ROW,COL) < >1  THEN  PRINT N(ROW,COL);
  149. 1580  REM  PUT "()" AROUND POS FRACS
  150. 1590  IF D(ROW,COL) < >1  AND N(ROW,COL) >0  THEN  PRINT "(";N(ROW,COL);"/";D(ROW,COL);")";
  151. 1600  REM  DON'T PUT "()" AROUND NEG FRACS
  152. 1610  IF D(ROW,COL) < >1  AND N(ROW,COL) <0  THEN  PRINT N(ROW,COL);"/";D(ROW,COL);
  153. 1620  REM  PRINT VARIABLE NAME:
  154. 1630  IF COL = 1  THEN  PRINT "X";
  155. 1640  IF COL = 2  THEN  PRINT "Y";
  156. 1650  NEXT COL
  157. 1660  REM  HERE, HAVE DEALT WITH ALL X'S
  158. 1670  REM  IF FLAG = 0, ALL COEFS WERE 0
  159. 1680  IF FLAG = 0  AND N(ROW,VARS +1) = 0  THEN 1760: REM   WHOLE EQN IS ZERO
  160. 1690  IF FLAG = 0  AND N(ROW,VARS +1) < >0  THEN  PRINT "ZERO";: REM    X TERMS 0, CONST NON-ZERO
  161. 1700  REM  HERE, FLAG<>0, SO HAVE NON-ZERO X TERM
  162. 1710  PRINT "=";
  163. 1720  PRINT N(ROW,VARS +1);
  164. 1730  REM   DON'T PRINT "1" DENOMS:
  165. 1740  IF D(ROW,VARS +1) < >1  THEN  PRINT "/";D(ROW,VARS +1);
  166. 1750  REM  CLEAR TO END OF LINE:
  167. 1760  PRINT  SPC( 40 - POS(0))
  168. 1770 FLAG = 0
  169. 1780  RETURN 
  170. 1790  REM 
  171. 1800  REM  
  172. 1810  REM  SUB TO MULT EQN BY CONST
  173. 1820  REM 
  174. 1830  HOME 
  175. 1840  PRINT "MULTIPLY WHICH EQUATION";: INPUT ROW
  176. 1850  PRINT 
  177. 1860  PRINT "MULTIPLY BY WHAT?": GOSUB 830: REM  FRAC GETTER 
  178. 1870  REM  SET UP FOR MULT SUBRTN
  179. 1880 N1 = NUM:D1 = DEN
  180. 1890  FOR COL = 1 TO VARS +1
  181. 1900 N2 = N(ROW,COL):D2 = D(ROW,COL)
  182. 1910  GOSUB 480: REM  MULT SUBRTN
  183. 1920 N(ROW,COL) = N3:D(ROW,COL) = D3
  184. 1930  NEXT COL
  185. 1940  REM  PRINT EQUATIONS
  186. 1950  GOSUB 2450
  187. 1960  RETURN 
  188. 1970  REM 
  189. 1980  REM 
  190. 1990  REM 
  191. 2000  REM  SUB TO ADD EQUATIONS
  192. 2010  REM   ADD EQN FST TO EQN SND 
  193. 2020  REM  PUT RESULT IN EQN SND
  194. 2030  REM 
  195. 2040  PRINT "ADD EQUATION I TO EQUATION J": PRINT 
  196. 2050  PRINT " I = ": INPUT FST: PRINT 
  197. 2060  PRINT " J = ": INPUT SND: PRINT 
  198. 2070  FOR COL = 1 TO VARS +1
  199. 2080  REM  SET UP FOR ADD SUBRTN
  200. 2090 N1 = N(FST,COL):D1 = D(FST,COL)
  201. 2100 N2 = N(SND,COL):D2 = D(SND,COL)
  202. 2110  GOSUB 720: REM  ADD SUBRTN
  203. 2120 N(SND,COL) = N3:D(SND,COL) = D3
  204. 2130  NEXT 
  205. 2140  REM   PRINT EQUATIONS:
  206. 2150  GOSUB 2450
  207. 2160  RETURN 
  208. 2170  REM 
  209. 2180  REM  MENU SUBROUTINE
  210. 2190  REM 
  211. 2200  HOME 
  212. 2210  PRINT " THIS PROGRAM WORKS WITH LINEAR"
  213. 2220  PRINT : PRINT "EQUATIONS IN TWO VARIABLES."
  214. 2230  PRINT : PRINT "     IT CAN:"
  215. 2240  PRINT : PRINT "MULTIPLY AN EQUATION BY A CONSTANT"
  216. 2250  PRINT : PRINT "AND ADD ONE EQUATION TO ANOTHER."
  217. 2260  PRINT : PRINT 
  218. 2270  PRINT : PRINT "NUMBERS MAY BE ENTERED AS FRACTIONS X/Y"
  219. 2280  VTAB 20: PRINT "PRESS ANY KEY TO CONTINUE"
  220. 2290  GET ANS$
  221. 2300  HOME 
  222. 2310  PRINT "ADD:TYPE A ","MULT:TYPE M"
  223. 2320  PRINT 
  224. 2330  PRINT "STOP :TYPE S"
  225. 2340  PRINT 
  226. 2350  POKE 34,4
  227. 2360  GOSUB 1070: REM  GET EQUATIONS
  228. 2370  HOME 
  229. 2380  PRINT "WHAT DO YOU WANT TO DO NOW";: INPUT DIR$
  230. 2390  IF DIR$ = "S"  THEN  POKE 34,0: PRINT : PRINT "SO LONG!": FOR I = 1 TO 1000: NEXT I: PRINT  CHR$(4);"RUN MENU"
  231. 2400  IF DIR$ = "A"  THEN  GOSUB 1990: GOTO 2370
  232. 2410  IF DIR$ = "M"  THEN  GOSUB 1800: GOTO 2370
  233. 2420  PRINT : PRINT "I DON'T KNOW HOW TO ";DIR$: PRINT : GOTO 2380
  234. 2430  REM 
  235. 2440  REM 
  236. 2450  REM  SUB TO PRINT ALL EQUATIONS
  237. 2460  REM 
  238. 2470  POKE 34,4
  239. 2480  HOME 
  240. 2490  FOR ROW = 1 TO EQNS
  241. 2500  GOSUB 1410
  242. 2510  NEXT 
  243. 2520  POKE 34,6 +EQNS
  244. 2530  RETURN 
  245. 2540  REM